perm filename G[X,ALS] blob
sn#075320 filedate 1973-12-05 generic text, type T, neo UTF8
00010 ENTRY PREPARE;
00020 BEGIN
00030 DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040 EXTERNAL REAL ARRAY C,D[0:512];
00050 EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00060 INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
00067 INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
00072 INTEGER I,J,K,P;
00077 EXTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2;
00080
00090
00100
00110
01000 PROCEDURE DEFINES;
01010 BEGIN
01020 F1_LOW← 200 * 256%10000; F1_HI← 800 * 256%10000;
01030 F2_LOW← 800 * 256%10000; F2_HI← 2050 * 256%10000;
01040 F3_LOW← 2000 * 256%10000; F3_HI← 3200 * 256%10000;
01045 F4_LOW← 2700 * 256%10000; F4_HI← 4000 * 256%10000;
01047 F5_LOW← 3600 * 256%10000; F5_HI← 5400 * 256%10000;
01050
01060 FP1_LO← 1800 * 256%10000; FP1_H← 3200 * 256%10000;
01070 FP2_LO← 3200 * 256%10000; FP2_H← 5000 * 256%10000;
01080
01090
01100 NP_LOW← 800 * 256%10000; NP_HI← 1500 * 256%10000;
01110 NZ_LOW←NP-500* 256%10000; NZ_HI←NP+500* 256%10000;
01120 END;
01130
01140
02000 INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
02010 BEGIN
02020 INTEGER I,J; REAL MAX;
02030
02040 MAX←-10000;
02050
02060 FOR I←LOW STEP 1 UNTIL HIGH DO
02070 IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
02080
02090 IF J=LOW THEN BEGIN
02100 MAX←-10000;
02110 FOR I←LOW+1 STEP 1 UNTIL HIGH DO
02120 IF C[I]>C[I-1] THEN BEGIN MAX←C[I]; J←I; END;
02130 IF MAX=-10000 THEN J←-1; ⊂ No proper peak has been found;
02140 END;
02150
02160 IF J=HIGH THEN BEGIN
02170 MAX←-10000;
02180 FOR I←HIGH-1 STEP -1 UNTIL LOW DO
02190 IF C[I]>C[I+1] THEN BEGIN MAX←C[I]; J←I; END;
02200 IF MAX←-10000 THEN J←-2; ⊂ No proper peak has been found;
02210 END;
02240
02250 RETURN(J);
02260 END;
02270
03000 PROCEDURE FORMANT;
03010 BEGIN
03020
03030 IF INFLAG=0 THEN BEGIN
03035
03040 INNAME[P]←CVASC("F1"); P←P+1;
03050 INNAME[P]←CVASC("F2"); P←P+1;
03060 INNAME[P]←CVASC("F3"); P←P+1;
03070
03080 INNAME[P]←CVASC("A1"); P←P+1;
03090 INNAME[P]←CVASC("A2"); P←P+1;
03100 INNAME[P]←CVASC("A3"); P←P+1;
03110
03120 END ELSE BEGIN
03130
03140 F1←PEAK(F1_LOW,F1_HI);
03150 F2←PEAK(F2_LOW,F2_HI);
03160 F3←PEAK(F3_LOW,F3_HI);
03170
03180 IF F2=F1 THEN BEGIN F2←PEAK(F1_HI,F2_HI);
04999
05000 INTERNAL PROCEDURE PREPARE;
05100 BEGIN
05200 OUTSTR("This is a dummy PREPARE package"&CRLF);
05300 END;
05310
05320 END;
05400